00100		TITLE SLOOP
00200		ENTRY RNOTE,DRWNT,RDRAW,SLOOP,CIRCLE,PSRT,RUNTHR
00300		EXTERNAL PTR,XRN,STF,.COMM.,CLEFS,AMOD,LINES,ALF,SLR
00400		EXTERNAL EXP3.2,SIN,COS,ATAN2,PLTR,SIND,COSD
00500		DEFINE FIXX(N)
00600	<	JUMPGE	N,.+5
00700		MOVNS	N
00800		FIX 	N,233000    
00900		MOVNS	N
01000		CAIA
01100		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01200	
01300		RB←15↔RX←14↔RA←13↔R←12↔KK←11↔V←10↔RW←7↔RZ←6↔SY←5
01400	SLOOP:	0
01500		SETZM CIRCLE	;WILL BE FLAG FOR REVERSING LOOP
01600		MOVE [1.0]
01700		MOVEM RDRAW
01800		MOVE	RB,.COMM.+=18	;RB=RX/71.
01900		FDVR	RB,[=71.0]
02000		SETZ	KK,	;DO 81 K=0,71
02100		SETZ RX,
02200	SLR81:	MOVE	RA,RX
02300		FADR RX,[1.0]
02400		FMPR	RA,RB
02500		FADR	RA,.COMM.+4	;81	SLURX(K+1)=RB*(K)+R3
02600		MOVEM RA,SLR(KK)
02700		CAIGE	KK,=71
02800		AOJA	KK,SLR81
02900		MOVE	RA,.COMM.+=8	;RA=R7*RST7
03000		FMPR	RA,.COMM.+=17
03100		SKIPN	RX,.COMM.+=10	;41	IF(R9.EQ.0)R9=RZZ
03200		MOVE	RX,[=2.8]	;RX IS R9
03300		SETZ RB,
03400	SLR41:	MOVE	R,.COMM.+2	;R=R+RA    CENTR IS R
03500		FADR	R,RA
03600		MOVE V,.COMM.+=41	;THIS IS RJ
03700		MOVE KK,[36.0]		;JS=36
03800		SKIPLE V	 	;IF(RJ.GT.0)JS=72
03900		MOVE KK,[72.0]		;DO 40 K=JS,1,-1
04000		MOVEM KK,RNOTE		;RNOTE=JS  SAVE IT FOR DIVIDE LATER
04100		MOVNS	RA
04200		CAML  V,[200.0]		;IF(RJ.GE.200)SET REVERSE FLAG
04300		SETOM CIRCLE
04400		MOVE 2,.COMM.+=11	;IF R10 .NE. 0 SHIFT CENTER OF SLUR.
04500		JUMPLE 2,SLR40   ; SKIPS NEG OR 0 IN P10
04510		CAML 2,[1.0]	; SKIPS P10>1.0
04520		JRST SLR40
04600		CAML 2,[0.5]	; IS P10 .LT. .5??
04700		JRST .+4
04800		SETOM CIRCLE	; SET THE REVERSE FLAG
04900		MOVE [1.0]
05000		FSBRM 2
05100		MOVE KK,[72.0]
05200		FMPR KK,2	;KK=1ST 'HALF' OF SLUR
05300		MOVEM KK,RNOTE	 ;**** CANNOT USE P9 WITH P7>100!!!!!!
05400		MOVE [72.0]
05500		FSBR RNOTE
05600		MOVE 1,RNOTE		; INCR=RNOTE/(72-RNOTE)
05700		FDVR 1,
05800		MOVEM 1,RDRAW		;INCR. FOR 2ND 'HALF'
05900	SLR40:	AOJ RB,		; L=L+1
06000		MOVE	2,KK		;RW=R-RA*(K/RNOTE)**R9
06100		FDVR	2,RNOTE  
06200		CAML 2,[0.1]	;NEXT IS TO AVOID UNDERFLOW IN EXP3.2
06300		JRST .+3
06400		MOVEM R,ALF(RB)
06500		JRST UNDER
06600		MOVE	3,RX
06700		PUSHJ	17,EXP3.2	; I HOPE! AC2=AC2**AC3
06800		FMPR	2,RA
06900		MOVE	RW,2
07000		FADR	RW,R
07100		MOVEM RW,ALF(RB)  ;SLURY(L)=RW	;ALF IS 1 BEFORE SLURY(1)
07200	;;UNDER:	MOVE .COMM.+=41		;IF(RJ.GT.0)GO TO 40
07300	;;	JUMPG RJ40
07400	;;	MOVE 2,[73.0]	; NOW IT MUST BE FLOATING POINT
07500	;;	FSBR 2,V	;VARIABLE LENGTH 2ND 'HALF' OF SLUR
07600	;;	FIXX(2)	
07700	;;	FADR V,RDRAW	;ADD THE NOW VARIABLE INCR. 2/76
07800	;;	MOVEM RW,ALF(2)
07900	UNDER:	CAMG KK,[1.0]	;40 CONTINUE	
08000		JRST .+3
08100		FSBR KK,[1.0]		; INCREMENT--SUBTRACT IT.
08200		JRST SLR40		; LOOP BACK
08300		MOVE 2,RNOTE 
08400		CAME 2,[72.0]	; JUMP IF HALF SLURS WERE DRAWN (R7>100)
08500		JRST SLR4
08600	SLR5:	JUMPE V,.+3	; CHECK FOR REVERSE FEATURE.
08700		MOVE 1,CIRCLE
08800		JUMPGE 1,SLR3	;NO RETRO NECESSARY
08900		MOVEI KK,1
09000		MOVEI RB,=72
09100		MOVE R,.COMM.+1	;PUT DIFF. INTO JA FOR 2ND AND 3RD TIMES AROUND
09200		MOVE SY,ALF+=36		; MID-POINT OF SLUR
09300		MOVE R,.COMM.+1		;IF(JA.EQ.5)GO TO SLR6
09400		CAIN R,5
09500		JRST SLR6
09600		MOVE 2,ALF+=36 ;DO ALL THIS ONLY 2ND AND 3RD TIMES.
09700		FSBR 2,R
09800		FDVR 2,[18.0] ;GET RIGHT PORTION OF DIFF. BETWEEN CURVES.
09900		MOVE 1,[36.0]	; SET THE COUNTER
10000	SLR6:	MOVE RZ,ALF(RB)		; THIS LOOP REVERSES ALL Y COORDS.
10100		EXCH RZ,ALF(KK)
10200		JUMPN V,SLR7
10300		MOVE RZ		; SAVE IT FOR NOW
10400		FSBR RZ,SY
10500		FADR RZ,RZ
10600		MOVNS RZ
10700		FADR RZ,	; PUTS POINT UP WHERE IT NOW SHOULD BE.
10800		CAIN R,5	;IF(JA.EQ.5)SET UP FOR NEXT TIMES AROUND
10900		JRST SLR7
11000		MOVE 2		; GET THE FACTOR
11100		FMPR 1		; MULT BY THE COUNTER
11200		FSBR RZ,	; SUBTR. IT FROM THIS POINT ON THE CURVE
11300		FSBR 1,[1.0]	;UPDATE COUNTER
11400	SLR7:	MOVEM RZ, ALF(RB)
11500		CAIN KK,=36
11600		JRST SLR1		; ALL DONE
11700		SOJ RB,
11800		AOJA KK,SLR6
11900	
12000	SLR4:	MOVEI RZ,=72
12100		MOVE RB,RDRAW	;'HALF' INCR.
12200		MOVE KK,[1.0]
12300	
12400	SLR2:	MOVE SY,KK	; PUTS 1ST 'HALF' DATA INTO 2ND 'HALF'
12500		FIXX(SY)	;   CAN BE USED FOR 'REVERSED' SLURS!
12600		MOVE 2,ALF(SY)
12700		MOVEM 2,ALF(RZ)
12800		FADR KK,RB	;KK=KK+INCRX
12900		CAMLE KK,RNOTE	; IS KK PAST THE 'MIDDLE'?
13000		JRST SLR5	; YES
13100		SOJ RZ,		; NO, SUBTRACT ONE
13200		JRST SLR2
13300	
13305	SLR1:	CAIE R,5
13307		JRST SLR3
13310		MOVE R,ALF+=36 ;STORE MID-POINT OF SLUR IN JA'S AC.
13355		MOVEM R,.COMM.+1
13400	SLR3:	MOVE	2,.COMM.+=20	;89	IF(RTILT.EQ.0)GO TO 87
13500		JUMPE	2,SLR87		;RETURNS
13600		JSA	16,ATAN2	;RW=ATAN2(RTILT,RXX)
13700		JUMP	.COMM.+=20
13800		JUMP	.COMM.+=19
13900		MOVE	RW,0
14000		JSA	16,SIN		;RA=SIN(RW)
14100		JUMP	RW		; ????
14200		MOVE	RA,0
14300		JSA	16,COS		;RB=COS(RW)
14400		JUMP	RW
14500		MOVE	RB,0
14600		MOVE	RZ,SLR		;RZ=SLURX(1)
14700		MOVE	RW,ALF+1		;RW=SLURY(1)
14800		MOVEI	KK,SLR		;DO 83 K=1,L
14900		MOVEI	4,=72
15000		ADDI	4,-1(KK)	;ADR. OF SLURX(L+1)
15100		MOVEI	SY,ALF+1
15200	SLR83:	MOVE	R,(KK)	;R=SLURX(K)-RZ
15300		FSBR	R,RZ
15400		MOVE	RX,(SY)		;RXX=SLURY(K)-RW
15500		FSBR	RX,RW
15600		MOVN	2,RA	;SLURX(K)=RB*R-RA*RXX+RZ
15700		FMPR	2,RX
15800		FADR	2,RZ
15900		MOVE	3,R
16000		FMPR	3,RB
16100		FADR 	3,2
16200		MOVEM	3,(KK)
16300		MOVE	2,RA		;83	SLURY(K)=RB*RXX+RA*R+RW
16400		FMPR	2,R
16500		FADR	2,RW
16600		MOVE	3,RX
16700		FMPR	3,RB
16800		FADR	3,2
16900		MOVEM	3,(SY)
17000		AOJ	SY,
17100		CAIGE	KK,(4)
17200		AOJA	KK,SLR83
17300	SLR87:	JRA	16,(16)
17400	A:	0
17500	B:	0
17600	L:	0
17700	
17800	RNOTE:	0	;	SUBROUTINE RNOTE(X)
17900		MOVE	2,@(16)	;COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
18000		JSA	16,AMOD	;X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
18100		JUMP	2
18200		JUMP	[=1000.0]
18300		MOVE	2,0
18400		FIXX(2)
18800		MOVE 3,PTR-1(2)
19300		MOVE 3,XRN-1(3)
19400		MOVEM	3,@(16)
19500		JRA	16,1(16)	; END
19600	
19700	DRWNT:	0   	;	SUBROUTINE DRWNT  [RMINI IS ALF+=49]
19800		MOVE	2,.COMM.+2	;COMMON /STF/RSTFAC(-3/4),RSTJ2
19900		MOVEM	2,A
20000		SETZM	.COMM.+=29	;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)	
20100		MOVE	2,.COMM.+=26;EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
20200		MOVEM	2,B
20300		MOVE	2,.COMM.+7 ;1(JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
20400		MOVEM	2,L
20500			 ;1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
20800		MOVE	2,ALF+=49	;RJX=CENTR
20900		FMPR	2,[=0.5]	;JH=0  J8
21000	;  JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
21100		FDVR	2,STF+=8	;RA=R6
21200		MOVEM	2,.COMM.+7		;R6=.5*RMINI/RSTJ2
21300		MOVEM	2,.COMM.+=8		;R7=R6
21400	;;	MOVE	2,.COMM.+=23	;RJD=RJZ-3
21450		MOVE 2,.COMM.+=23	;THIS IS RJZ IN NTS
21500		FSBR	2,[=3.0]
21600		MOVEM	2,.COMM.+5
21700	;  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
22000		SETZM	.COMM.+=30		;JI=0
22100		JSA	16,CLEFS	;CALL CLEFS
22200		MOVE	2,.COMM.+=10
22300		FIXX(2)
22400		MOVEM	2,.COMM.+=30	;JI=R9  (I SAVED JI IN 2)
22500	;  ↑↑↑↑↑↑ NEEDED??
22600	;  FOR WHITE NOTES AND ACCIS ON PLOTTER.
22700		MOVE	2,A
22800		MOVEM	2,.COMM.+2		;CENTR=RJX
22900		MOVE	2,L
23000		MOVEM	2,.COMM.+7		;R6=RA
23100		MOVE	2,.COMM.+=28
23200		TLC	2,232000	; FLOAT IT.
23300		FADR	2,2
23400		MOVEM	2,.COMM.+=8	;R2=JG
23500		MOVE	2,.COMM.+6
23600		FIXX(2)
23700		MOVEM	2,.COMM.+=26	;JE=RJE	
23900		JRA	16,(16) 	;END	(ALIGNMENT ABOVE IS OFF!)
24000	
24100	RDRAW:	0  ;	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
24200		MOVEI	2,@2(16) ;C   TO X,Y INTO ONE WORD
24300		ADD	2,@(16)		;DIMENSION XY(1)
24400		MOVE	3,@1(16)	;DO 2 K=I,IFIX(S)
24500		FIXX(3)
24600		MOVEI	10,@2(16)
24700		ADDI	10,(3)
24800		MOVEM	10,DRWNT	;SAVE IT FOR NOW
24900	RD2:	MOVEI	4,2		; L=2
25000		MOVE	5,-1(2)		; Y=XY(K)
25100		CAMGE	5,[=1000.0]	;IF(Y.LT.1000.)GO TO 3
25200		JRST	RD3
25300		MOVEI	4,3		;L=3
25400		FSBR	5,[=1000.0]	;Y=Y-1000.
25500	;   >1000 = INVIS. LINE
25600	RD3:	MOVE	6,5	;3	M=Y
25700		MOVEM	4,L
25800		FIXX(6)		; M
25900		MOVE	7,6	;Y=(Y-M)*1000.
26000		TLC	7,232000
26100		FADR	7,7	; FLOATS
26200		FSBR	5,7
26300		FMPR	5,[=1000.0]	; Y
26400		CAMG	5,[=100.0]	;IF(Y.GT.100.)Y=100-Y
26500		JRST 	RD4
26600		FSBR	5,[=100.0]
26700		MOVNS	5
26800	RD4:	FMPR	5,@3(16)
26900	;   Y NUMBERS .GT.100 ARE NEG.
27000		FADR	5,@5(16)	;B=Y*X+CENTR
27100		CAIG	6,=60		;IF(M.GT.60)M=100-M
27200		JRST	RD5
27300		SUBI	6,=100
27400		MOVNS	6
27500	RD5:	TLC	6,232000     ;	A=M*RMINI+R3
27600		FADR	6,6
27700		FMPR	6,@6(16)
27800		FADR	6,@4(16)
27900		MOVEM	6,A
28000		MOVEM	5,B
28100		MOVEM	2,RNOTE		;SAVE IT FOR A SECOND
28200		JSA	16,LINES	;2	CALL LINES(A,B,L)
28300		JUMP	A
28400		JUMP	B
28500		JUMP	L
28600		MOVE	2,RNOTE
28700		CAMGE	2,DRWNT
28800		AOJA	2,RD2
28900		JRA	16,7(16)
29000	
29100	CIRCLE:	0		;	RA=5.96*RSJT2*R5
29200		MOVE	RA,.COMM.+6
29300		FMPR	RA,[=5.96]
29400		FMPR	RA,STF+=8
29500		MOVE	RB,.COMM.+=29	;J8=J8*RDIS
29600		TLC	RB,232000	;FLOAT
29700		FADR	RB,RB
29800		FMPR	RB,PLTR+2
29900		MOVE	RX,.COMM.+=28	;IF(J7.LE.J6)J7=J7+360
30000		CAMLE	RX,.COMM.+=27	;RX IS J7
30100		JRST	C2
30200		ADDI	RX,=360
30300	C2:	MOVEI	RZ,6	;	KQ=6
30400		MOVE	2,PLTR		;IF(PLT)KQ=1
30500		SKIPGE	2
30600		MOVEI	RZ,1		
30700		MOVEM	RZ,DRWNT	; DRWNT IS KQ
30800	C10:	MOVE	KK,.COMM.+=27	;10	DO 3 K=J6,J7,KQ
30900		MOVEI	V,3		;L=3
31000		MOVEM	V,L
31100	C3:	MOVE	R,KK		;R=K
31200		TLC	R,232000
31300		FADR 	R,R
31400		MOVEM	R,A  ;CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
31500		JSA	16,SIND
31600		JUMP	A
31700		FMPR	0,RA
31800		FADR	0,.COMM.+4
31900		MOVEM	0,B
32000		JSA	16,COSD
32100		JUMP	A
32200		FMPR	0,RA
32300		FADR	0,.COMM.+2
32400		MOVEM	0,A
32500		JSA	16,LINES
32600		JUMP	B
32700		JUMP	A
32800		JUMP	L
32900		MOVEI	V,2	;3	L=2
33000		MOVEM	V,L
33100		ADD	KK,DRWNT
33200		CAIG	KK,(RX)
33300		JRST	C3 
33400		FSBR	RB,[1.0]	;J8=J8-1
33500		JUMPL	RB,SLR87	;IF(J8)RETURN
33600		MOVE	2,[1.0]		;RA=RA+1/RDIS
33700		FDVR	2,PLTR+2
33800		FADR	RA,2
33900		JRST 	C10		;GO TO 10
34000	;JA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
34100				;RETURN
34200	
34300	;;	SUBROUTINE PSRT(P)
34400	;; SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
34500	;;	IMPLICIT INTEGER(S-Z)
34600	;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
34700	;;	DIMENSION  P(250) **** AN ARGUMENT, INSTEAD.
34800	MM←1↔NN←2↔J←3↔LL←4↔ AA←6↔Y←7↔V←10 ↔R←12↔RN←13↔K←14
34900	PSRT:	0	;	DO 4 K=1,ITEM
35000		MOVEI	K,@(16)		; ADR OF P
35100		MOVEI	MM,PTR		;L=PWDS(K)
35200		MOVEI RB,(MM)
35300		MOVE	NN,PTR+=250	; ITEM
35400		ADDI	NN,-1(MM)		; LAST ADR. OF PWDS
35500		MOVE SY,[16.0]
35600	PL4:	MOVE	R,(MM)		;LL=PWDS(K-1)
36000					;LM=PWDS(K+1)
36200					;A=RN(L+3)
36500					;P(K)=A+1000*RN(L+2)
36600		MOVE AA,XRN+2(R)
36700		MOVE J,XRN+1(R)
36800		FMPR	J,[=1000.0]
36900		FADR	J,XRN+2(R)	; IF(RN(L+1).NE.16)GO TO 40
37100		MOVE V,XRN(R)
37200		CAME	V,[=8.0]	;IF(RN(L+1).EQ.8)P(X)=P(X)-16
37300		JRST	PLA
37400		FSBR	J,[=16.0]
37500		MOVE	AA,[=1000.0]
37600	PLA:	MOVEM	J,(K)
37800		CAME V,SY
37900		JRST	PL40
38000		CAIN RB,(MM)
38100		JRST PLAQ		;IF (K.EQ.1) GO TO PLAQ
38200		MOVE	Y,-1(MM)	;Y=PWDS(K-1)
38300		CAMN SY,XRN(Y)
38400		JRST 	PL41
38500	PLAQ:	MOVE	V,1(MM)		;V=PWDS(K+1) ;IF(RN(V+1).EQ.16)GO TO 41
39000		CAMN SY,XRN(V)
39200		JRST	PL41
39300		JRST	PLS		;GO TO 4
39400	PL40:	JUMPGE	AA,PLS 	;40	IF(A.GE.0)GO TO 4
39500	PL41:	MOVN	AA,[=10000.0]	;41	P(K)=-10000
39600		MOVEM	AA,(K)
39700	PLS:	CAIL	MM,(NN)	;4	CONTINUE
39800		JRST	PLX
39900		AOJ	MM,
40000		AOJA	K,PL4
40100	;  PLOTS ALL NEG. POSITIONS FIRST.
40200	PLX:	MOVE	AA,PTR+=252	;IX=I
40300		MOVEM	AA,PTR+=253
40400		CAIL	AA,=1500		;IF(I.LT.1500)I=1500
40500		JRST 	PLY
40600		MOVEI	AA,=1500
40700		MOVEM	AA,PTR+=252
40800	PLY:	MOVEI	Y,(AA)		;	Y=I
40900		ADD	AA,PTR+=253	;I=I+IX-1
41000		SUBI	AA,1
41100		MOVEM	AA,PTR+=252
41200		MOVEM	Y,PTR+=253	;IX=Y
41300	;  IX IS M IN MAIN PROG.
41400	;  LEAVES 1500 WDS IN RN FOR STORING "NOIR" DATA.
41500	PL2:	MOVE	AA,@(16)		;2	A=P(1)
41600		MOVEI	R,1		;L=1
41700		MOVEI	J,1
41800		MOVEI	K,@(16)		;DO 1 K=1,ITEM
41900		MOVE	NN,PTR+=250
42000		ADDI	NN,(K)	;P(ITEM)
42100	PL1:	CAMG	AA,(K)		;IF(A.LE.P(K))GO TO 1
42200		JRST	PLZ
42300		MOVE	AA,(K)		;A=P(K)
42400		MOVE	R,J		;L=K
42500	PLZ:	CAIL	K,-1(NN)	;1	CONTINUE
42600		JRST	PLW
42700		AOJ	K,
42800		AOJA	J,PL1
42900	PLW:	CAMN	AA,[=10000.0]	;	IF(A.EQ.10000.)RETURN
43000		JRA	16,1(16)
43100	;  ALL ITEMS HAVE NOW BEEN SHUFFLED
43200		MOVEI	V,PTR		;V=PWDS(L)
43300		ADDI	V,(R)
43400		MOVE	V,-1(V)
43600		MOVE	AA,[=10000.0]	;P(L)=10000
43700		MOVEI	J,@(16)
43800		ADDI	J,(R)
43900		MOVEM	AA,-1(J)
44000		MOVEI	R,XRN		;L=RN(V)+2+Y
44100		ADDI	R,(V)
44200		MOVE	R,-1(R)
44300		FIXX(R)
44400		ADDI	R,2
44500		ADDI	R,(Y)
44600		SUBI	V,(Y)		;V=V-Y
44800		MOVEI	K,XRN		;DO 3 K=Y,L
44900		ADDI	K,(Y)
45000		MOVEI	NN,XRN
45100		ADDI	NN,(R)
45200	PL3:	MOVEI	AA,(K)
45300		ADDI	AA,(V)		;3	RN(K)=RN(K+V)
45400		MOVE	AA,-1(AA)
45500		MOVEM	AA,-1(K)
45600		CAIGE	K,(NN)
45700		AOJA	K,PL3
45800	;; REPLACED SUBROUTINE LOOP
45900		MOVEI	Y,(R)		;Y=L+1
46000		ADDI	Y,1
46100		JRST	PL2		;GO TO 2
46200	
46300	RUNTHR:	0	; CALL RUNTHR(M)
46400		MOVE	5,@(16)	;GET M
46500		MOVEI	2,XRN	;GET RN LOC.
46600		ADDI	2,(5)	;2=LOC OF RN(M+1)
46700		MOVE	3,-1(2)		;3=CNT
46800		FIXX(3)
46900		MOVE	4,(2)		;M+1
47000		FIXX(4)	
47100		MOVEM	4,.COMM.+1	;JA=RN(M+1)
47200		ADDI	5,2		;M=M+2
47300		ADDI	2,1		; LOC OF RN(M) NOW
47400		MOVE	6,(2)
47500		MOVEM	6,.COMM.	;R2=RN(M)	
47600		MOVEI	13,.COMM.	;LOC OF COMMON BLOCK
47700		SETZ	7,	;K=0
47800	LP:	MOVEI	12,.COMM.
47900		ADDI	12,(7)	
48000		CAML	7,3		;ARE WE PAST COUNT?
48100		JRST	LZRO		;YES
48200		MOVEI	10,(5)
48300		ADDI	10,(7)		;M+K
48400		MOVEI	11,XRN
48500		ADDI	11,(10)		;LOC OF RN(M+K)
48600		MOVE	11,(11)
48700		MOVEM	11,4(12)	;RJQ(K)=RN(M+K)
48800		FIXX(11)
48900		MOVEM	11,=24(12)	;JQ(K)=
49000		JRST	LB
49100	LZRO:	SETZM	4(12)		;RJQ(K)=0
49200		SETZM	=24(12)		;JQ(K)=0
49300	LB:	CAIE	7,=9	; LESS THAN 10?
49400		AOJA	7,LP
49500		ADDI	5,(3)	; M=CNT+M+1
49600		ADDI	5,1
49700		MOVEM	5,@(16)
49800		JRA	16,1(16)
49900	
50000		END